home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / remotetime.mod (.txt) < prev    next >
Oberon Text  |  1996-07-15  |  3KB  |  95 lines
  1. Syntax10.Scn.Fnt
  2. MODULE RemoteTime;    
  3. (*BD, 13.2.96 *)
  4.     IMPORT SYSTEM, Texts, NetSystem, Oberon;
  5.     CONST timeoffset= 1;
  6.     VAR S: NetSystem.Socket;
  7.         ServerIP: NetSystem.IPAdr;
  8.         ServerName: ARRAY 64 OF CHAR;
  9.         W: Texts.Writer;
  10.     PROCEDURE ConvertTime(time: LONGINT; VAR aa, mm, dd, h, m, s: LONGINT);
  11.         VAR julian, d, f, dy: LONGREAL;
  12.             help, i, a, b, ce, g, mn, yr: LONGINT;
  13.     BEGIN
  14.         help:= SYSTEM.LSH(time, -7);
  15.         help:= help MOD 1FFFFFFH; 
  16.         julian:= help / 675; 
  17.         d:=julian+1; i:= ENTIER(d); f:= d - i;
  18.         IF ENTIER(f) = 1 THEN f:= 0; INC(i) END;
  19.         IF i > -115860 THEN 
  20.             a:= ENTIER(((i/36524.25) + 0.99835726)) + 14;
  21.             i:= i +1+a-ENTIER(a/4);
  22.         END;
  23.         b:=ENTIER(((i/365.25) + 0.802601));
  24.         ce:= i-ENTIER((365.25*b)+0.750001) + 416;
  25.         g:= ENTIER(ce / 30.6001); 
  26.         mn:= g-1;
  27.         dy:= ce - ENTIER((30.6001*g)) + f; 
  28.         IF g>13.5 THEN mn:= g -13 END;
  29.         IF mn < 2.5 THEN yr:= b + 1900 ELSE yr:= b + 1899 END;
  30.         IF yr<1 THEN yr:= yr - 1 END;
  31.         aa:= yr;
  32.         mm:= mn;
  33.         dd:= ENTIER(dy);
  34.         help:= SYSTEM.LSH(time, -1);
  35.         help:= ((help MOD 43200) * 2) + time MOD 2;
  36.         h:= (help DIV 3600) + timeoffset; help:= help MOD 3600;
  37.         m:= help DIV 60; help:= help MOD 60;
  38.         s:= help;
  39.     END ConvertTime;
  40.     PROCEDURE WI(i: LONGINT);
  41.     BEGIN
  42.         IF i < 10 THEN Texts.WriteInt(W, 0, 1) END;
  43.         Texts.WriteInt(W, i, 1);
  44.     END WI;
  45.     PROCEDURE GetTime*;
  46.         VAR time, len: LONGINT;
  47.             timeDG, emptyDG: ARRAY 4 OF SYSTEM.BYTE;
  48.             res, port: INTEGER;
  49.             remIP: NetSystem.IPAdr;
  50.             TimeString: ARRAY 64 OF CHAR;
  51.             TimeStringAdr, i: LONGINT;
  52.             aa, mm, dd, h, m, s: LONGINT;
  53.     BEGIN 
  54.         NetSystem.OpenSocket(S, 20968, res);
  55.         IF res = NetSystem.done THEN
  56.             emptyDG[0]:= 0X;
  57.             NetSystem.SendDG(S, ServerIP, 37, 0, 1, emptyDG);
  58.             len:= SIZE(LONGINT);
  59.             WHILE NetSystem.AvailableDG(S) = 0 DO END;
  60.             NetSystem.ReceiveDG(S, remIP, port, 0, len, timeDG);
  61.             NetSystem.GetLInt(timeDG, 0, time);
  62.             NetSystem.CloseSocket(S);
  63.             ConvertTime(time, aa, mm, dd, h, m, s);
  64.         END;
  65.         Texts.WriteString(W, "Current time on ");
  66.         Texts.WriteString(W, ServerName);
  67.         Texts.WriteString(W, " is: ");
  68.         WI(dd); Texts.WriteString(W, " . ");
  69.         WI(mm); Texts.WriteString(W, " . ");
  70.         WI(aa); Texts.WriteString(W, " , ");
  71.         WI(h); Texts.WriteString(W, " : ");
  72.         WI(m); Texts.WriteString(W, " : ");
  73.         WI(s); Texts.WriteLn(W);
  74.         Texts.Append(Oberon.Log, W.buf);
  75.     END GetTime;
  76.     PROCEDURE SetServer*;
  77.         VAR S: Texts.Scanner;
  78.     BEGIN
  79.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  80.         Texts.Scan(S); 
  81.         IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN 
  82.             COPY(S.s, ServerName);
  83.             NetSystem.GetIP(ServerName, ServerIP);
  84.         END
  85.     END SetServer;
  86. BEGIN
  87.     Texts.OpenWriter(W);
  88.     NetSystem.Start;
  89.     COPY(NetSystem.hostname, ServerName);
  90.     NetSystem.GetIP(ServerName, ServerIP);
  91. END RemoteTime.
  92. RemoteTime.SetServer neptune~
  93. RemoteTime.GetTime ~
  94. System.Free RemoteTime ~
  95.